perm filename BGBMAT[1,LMM] blob sn#034839 filedate 1973-04-11 generic text, type T, neo UTF8
  (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "11-APR-73 06:03:49")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE BGBMATCHVARS)
              T)
  (RPAQQ BGBMATCHVARS
         ((RECORD SUBGRAPH)
          (FNS APPREV ASSIGN ASSIGNFAIL DISJOINT DOTS DOTSCHECK EQSET 
               EXAMPLETYPE FILTERASSIGN HYDROGENS INVALID ISIT 
               LESSLENGTH LIKE NBRSCHECK NEIGHBORS NHSCHECK NORMSUBG 
               ONEP PRINTLREC PRUNEASSIGN RECDEF STRUCTURE-SUBGRAPH 
               SUBMATCH SUBMATCH1 SUBSETP TYPE UORDER RCHECK 
               VALDISTCHECK)
          (VARS ALDEHYDE AMINE BIGGRAPH DARING DARING1 DARINGLIST 
                DARINGSUB1 ETHER ETHERRING KETONE MAPPING MATCHNUM 
                OXIME RINGX RINGY STRUCTURE SUBGRAPH TEST2 THIOETHER 
                THIOL MATCHTESTLIST)))
(DEFLIST(QUOTE(
  (SUBGRAPH (SUBNODE SUBTYPE SUBNBRS SUBDOTS SUBNHS SUBXDOTS SUBXNHS))
))(QUOTE RECORD))

  (RECORD (QUOTE SUBGRAPH))
(DEFINEQ

(APPREV
  [LAMBDA (L1 L2)
    (APPEND (REVERSE L1)
            L2])

(ASSIGN
  [LAMBDA (SUB BIG MLIST)
    (PROG (X1 B1 ASGN)
      A   (COND
            ((NULL SUB)
              (RETURN ASGN)))
          (SETQ X1 (CAR SUB))
          (SETQ SUB (CDR SUB))
          [SETQ B1 (SUBSET BIG (FUNCTION (LAMBDA (U)

          (* Makes a preliminary assignment of atoms of SUB to 
          BIG -
          Using the set of tests given as MLIST 
          (which is a list of function names) -
          If the MLIST is NIL then the global variable 
          MATCHTESTLIST will be used)


                               (LIKE X1 U MLIST]
          (COND
            ((NULL B1)
              (RETURN NIL)))
          (SETQ ASGN (CONS (CONS X1 B1)
                           ASGN))
          (GO A])

(ASSIGNFAIL
  [LAMBDA (ASGN)
    (ONEP (LENGTH (CAR ASGN])

(DISJOINT
  [LAMBDA (L1 L2)
    (FOR NEW X IN L1 WHEN (NOT (MEMBER X L2))
                          LIST X])

(DOTS
  [LAMBDA (A)

          (* Gives the number of DOTS 
          (OR EQUIVALENT THEREOF) of A node of the BIGGRAPH)


    (COND
      (DOTNOTATION (ERROR "NOT IMPLEMENTED YET"))
      (T (FOR A ON A WHEN (AND (NOT (EQ (CAR A)
                                        (QUOTE FV)))
                               (MEMBER (CAR A)
                                       (CDR A)))
                          PLUS 1])

(DOTSCHECK
  [LAMBDA (SUB BIG)                             (* This FN can be made a
                                                member of MATCHTESTLIST)
    (IF (SUBXDOTS SUB)
        THEN (EQUAL (DOTS BIG)
                    (SUBXDOTS SUB))
      ELSE (LEQ (SUBDOTS SUB)
                (DOTS BIG])

(EQSET
  [LAMBDA (L1 L2)
    (AND (SUBSETP L1 L2)
         (SUBSETP L2 L1])

(EXAMPLETYPE
  [LAMBDA (SUBTYP BIGTYP)

          (* Checks for equivalence (or satisfaction of 
          nominal requirements-) for atom types of bigatom and 
          subatom)


    (SETQ BIGTYP (TYPE BIGTYP))
    (SETQ SUBTYP (SUBTYPE SUBTYP))
    (COND
      ((ATOM SUBTYP)
        (EQ BIGTYP SUBTYP))
      (T (MEMBER BIGTYP SUBTYP])

(FILTERASSIGN
  [LAMBDA (SUB BIG KNOWN)

          (* Takes off the assignment list those not 
          compatible in the light of matchings already made)


    (PROG (KN S1 VAL NSUB)
          (SETQ KN KNOWN)
      A   (COND
            ((OR (ATOM KN)
                 (ATOM SUB))
              (GO C)))
          (SETQ S1 (CAR SUB))
          (SETQ SUB (CDR SUB))
          (SETQ VAL (SASSOC (CAR S1)
                            KN NIL))
          (COND
            (VAL (GO B)))
          (SETQ NSUB (CONS S1 NSUB))
          (GO A)
      B   (COND
            ((NOT (LIKE S1 (CDR VAL)))
              (RETURN NIL)))
          (SETQ KN (REMOVE KN VAL))
          (GO A)
      C   (SETQ NSUB (APPREV SUB NSUB))
          (COND
            ((ATOM NSUB)
              (RETURN T)))
          [SETQ BIG (DISJOINT BIG (MAPCAR KNOWN (FUNCTION CDR]
          (COND
            ((LESSP (LENGTH BIG)
                    (LENGTH NSUB))
              (RETURN NIL)))
          (RETURN (ASSIGN NSUB BIG])

(HYDROGENS
  [LAMBDA (BIGATOM)

          (* Needs redefinition WHEN a different or 
          alternative manner of representing HYDROGENS is 
          devised)


    (FOR NEW N IN (NBRS BIGATOM) WHEN (EQ N (QUOTE FV))
                                      PLUS 1])

(INVALID
  [LAMBDA (PR OLDMAP)

          (* Believe that this function is the one that 
          assures the topological MAPPING between the SUBGRAPH 
          and BIGGRAPH by doing the detailed atom by atom 
          CHECK of the preservation of adjacency 
          (OR NEIGHBORHOOD) requirement)


    (PROG (B1 OLDB S1 NS NB X1)
          (COND
            ((NULL OLDMAP)
              (RETURN NIL)))
          (SETQ B1 (CDR PR))
          (COND
            ([MEMBER B1 (SETQ OLDB (MAPCAR OLDMAP
                                           (FUNCTION CDR]
              (RETURN T)))
          (SETQ S1 (CAR PR))
          (SETQ NS (SUBNBRS S1))
          (SETQ NB (NEIGHBORS B1))
          (SETQ X1 NB)
          [SETQ NB (FOR NEW X
                      IN X1 XLIST (FOR NEW Z IN OLDMAP
                                     WHEN (EQUAL (CDR Z)
                                                 X)
                                     DO (RETURN Z]
          (SETQ X1 NS)
          [SETQ NS (FOR NEW X
                      IN X1 XLIST (FOR NEW Z IN OLDMAP
                                     WHEN (EQUAL (CDR Z)
                                                 X)
                                     DO (RETURN Z]
          (COND
            ((EQSET NB NS)
              (RETURN NIL)))
          (RETURN T])

(ISIT
  [LAMBDA (SUBGRAPH BIGGRAPH)

          (* The toplevel function -- has now the flexibility 
          to supply the testlist to be used in making the 
          assignments)



          (* (only one match will be tried -- and true or 
          false determined from that))


    (SUBMATCH SUBGRAPH BIGGRAPH 1])

(LESSLENGTH
  [LAMBDA (L1 L2)
    (NOT (GREATERP (LENGTH L1)
                   (LENGTH L2])

(LIKE
  [LAMBDA (SUBATOM BIGATOM MLIST)
    (FOR NEW TEST IN (OR MLIST MATCHTESTLIST)
                     AND (APPLY* TEST SUBATOM BIGATOM])

(NBRSCHECK
  [LAMBDA (SUB BIG)
    (LEQ (LENGTH (SUBNBRS SUBATOM))
         (LENGTH (NEIGHBORS BIGATOM])

(NEIGHBORS
  [LAMBDA (A)
    (MAPCAR (NBRS A)
            (FUNCTION (LAMBDA (X)
                (COND
                  ((NOT (EQ (QUOTE FV)
                            X))
                    (FINDCTE X STRUCTURE])

(NHSCHECK
  [LAMBDA (SUB BIG)
    (IF (SUBXNHS SUB)
        THEN (EQUAL (HYDROGENS BIG)
                    (SUBXNHS SUB))
      ELSE (LEQ (SUBNHS SUB)
                (HYDROGENS BIG])

(NORMSUBG
  [LAMBDA (SUB)

          (* Throws a SUBGRAPH from a non-standard def to the 
          FORM as per RECORD definition of SUBGRAPH)

                                                (* Will CHANGE when the 
                                                RECORD definition 
                                                alters)
    (FOR NEW S IN SUB LIST (SUBGRAPH FROM S SUBNHS (COND
                                            ((SUBNHS S))
                                            (T 0))
                                          SUBDOTS
                                          (COND
                                            ((SUBDOTS S))
                                            (T 0])

(ONEP
  [LAMBDA (N)
    (EQP N 1])

(PRINTLREC
  [LAMBDA (REC VAL)

          (* First argument is the atom , the name of a RECORD 
          -- the second argument is a list 
          (not just one RECORD -
          You can use PRINTREC for that) and loops thru and 
          calls PRINTREC)


    (FOR NEW R IN VAL DO (PRINTREC REC R)
                         (PRINT "=========================")
                         (TERPRI])

(PRUNEASSIGN
  [LAMBDA (SUB BIGS OLDMAP BG)                  (* Will have to ask 
                                                buchanan or look up his 
                                                documentation)
    (PROG (X1 NMAP NB NNB)
          (SETQ X1 (SUBNBRS SUB))
          [SETQ NMAP (SUBSET OLDMAP (FUNCTION (LAMBDA (U)
                                 (MEMBER (CAR U)
                                         X1]
          (COND
            ((NULL NMAP)
              (RETURN BIGS)))
          (SETQ NB (INTERSECTION NB NB))
          (SETQ NB (MAPCAR NMAP (FUNCTION CDR)))
          (SETQ NNB (MAPCONC NB (FUNCTION NEIGHBORS)))
          (RETURN (INTERSECTION BIGS NNB])

(RECDEF
  [LAMBDA (X)
    (OR (GETP X (QUOTE RECORD))
        (GETP X (QUOTE !RECORD])

(STRUCTURE-SUBGRAPH
  [LAMBDA (STRUC)
    (FOR NEW CT IN (CTABLE STRUC)
                   XLIST
                   (SUBGRAPH SUBNODE =(NODENUM CT)
                             SUBTYPE =(TYPE CT)
                             SUBNBRS =(NBRS CT)
                             SUBDOTS =(DOTS CT)
                             SUBNHS =(HYDROGENS CT)
                             SUBXNHS = NIL SUBXDOTS = NIL])

(SUBMATCH
  [LAMBDA (SUBGRAPH STRUC M)
    (PROG (ASSGN)
          (GSET (QUOTE MATCHNUM)
                M)
          (GSET (QUOTE STRUCTURE)
                (COND
                  ((STRUCTURE? STRUC)
                    (SETQ STRUC (CTABLE STRUC)))
                  (T STRUC)))
          (SETQ MAPPINGLIST NIL)
          (SETQ ASSGN (UORDER (FILTERASSIGN SUBGRAPH STRUC MAPPING)))
          [COND
            ((NULL ASSGN)
              (RETURN NIL))
            ((ATOM ASSGN)
              (RETURN (SETQ MAPPINGLIST (LIST MAPPING]
          (SUBMATCH1 (CAR ASSGN)
                     MAPPING
                     (CDR ASSGN)
                     STRUC)
          (RETURN MAPPINGLIST])

(SUBMATCH1
  [LAMBDA (NEWASSUME KNOWN POSSMAP BG)
    (PROG (NEWA1 ANS)
          (SETQ NEWASSUME (CONS (CAR NEWASSUME)
                                (PRUNEASSIGN (CAR NEWASSUME)
                                             (CDR NEWASSUME)
                                             KNOWN BG)))
      A   (COND
            ((NULL (CDR NEWASSUME))
              (RETURN NIL)))
          (SETQ NEWA1 (CONS (CAR NEWASSUME)
                            (CADR NEWASSUME)))
          (SETQ NEWASSUME (CONS (CAR NEWASSUME)
                                (CDDR NEWASSUME)))
          (COND
            ((INVALID NEWA1 KNOWN)
              (GO A)))
          (COND
            ((NULL POSSMAP)
              (GO B)))
          (SETQ ANS (SUBMATCH1 (CAR POSSMAP)
                               (CONS (CONS (CAAR NEWA1)
                                           (CDR NEWA1))
                                     KNOWN)
                               (CDR POSSMAP)
                               BG))
          (COND
            ((NULL ANS)
              (GO A)))
          (RETURN ANS)
      B   (SETQ MATCHNUM (SUB1 MATCHNUM))
          (SETQ MAPPINGLIST (CONS (CONS (CONS (CAAR NEWA1)
                                              (CDR NEWA1))
                                        KNOWN)
                                  MAPPINGLIST))
          (COND
            ((ZEROP MATCHNUM)
              (RETURN MAPPINGLIST)))
          (GO A])

(SUBSETP
  [LAMBDA (L1 L2)
    (FOR NEW X IN L1 AND (MEMBER X L2])

(TYPE
  [LAMBDA (A)
    (ATOMTYPE (MARKERS A])

(UORDER
  [LAMBDA (ASGN)

          (* Sorts the atoms of SUBGRAPH according to 
          increasing sets of possible MAPPING BIGGRAPH atoms-- 
          believe this helps in finding non-matches quicker)


    (PROG (ANS)
          (SETQ ANS (SORT ASGN (FUNCTION LESSLENGTH)))
          (COND
            ((ASSIGNFAIL ANS)
              (RETURN NIL)))
          (RETURN ANS])

(RCHECK
  [LAMBDA NIL
    (PROG NIL
          (FOR NEW I :=(SON TILL)
               AS NEW L IS (NTH LL I)
             WHEN (NOT (MEMBER I REDUNDANTS))
                  LIST
                  (FOR NEW X
                     ON (NTH XX (ADD1 I))
                        AS NEW J :=((ADD1 I)
                         17)
                        LIST
                        (TERPRI)
                        (TERPRI)
                        (PRINT I)
                        (PRINT J)
                        (TIME [COND
                                ((ISIT (CAR X)
                                       (CAR L))
                                  (PRINT (QUOTE 
                                           ********************SAME))
                                  (SETQ REDUNDANTS (CONS J REDUNDANTS)))
                                (T (PRINT (QUOTE DO-NOT-MATCH]
                              1 0])

(VALDISTCHECK
  [LAMBDA (SUB BIG)
    (EQUAL (CLCREATE (FOR NEW X IN (CLCREATE (NBRS BIG))
                                   LIST
                                   (CDR X)))
           (CLCREATE (FOR NEW X IN (CLCREATE (SUBNBRS SUB))
                                   LIST
                                   (CDR X])
)
  (RPAQQ ALDEHYDE ((1 C (2)
                      1 0 NIL 1)
          (2 O (1)
             1 0 NIL NIL)))
  (RPAQQ AMINE ((1 N NIL 0 0 NIL NIL)))
  (RPAQQ BIGGRAPH NIL)
  [RPAQQ DARING (STRUCTURE ((CTENTRY 1 (NIL)
                                     6 2 2)
                            (CTENTRY 2 (NIL)
                                     3 1 1)
                            (CTENTRY 6 (NIL)
                                     1 5)
                            (CTENTRY 5 (NIL)
                                     6 4)
                            (CTENTRY 4 (NIL)
                                     5 3)
                            (CTENTRY 3 (NIL)
                                     2 4))
                           (MBONDS . 3)
                           6
                           ((6 5 4 3)
                            (1 2))
                           ((3 4 5 6)
                            (2 1]
  [RPAQQ DARING1 (STRUCTURE ((CTENTRY 1 (N)
                                      6 2 2)
                             (CTENTRY 2 (C)
                                      3 1 1)
                             (CTENTRY 6 (N)
                                      1 5)
                             (CTENTRY 5 (N)
                                      6 4)
                             (CTENTRY 4 (C)
                                      5 3)
                             (CTENTRY 3 (C)
                                      2 4))
                            (MBONDS . 3)
                            6
                            ((6 5 4 3)
                             (1 2]
  [RPAQQ DARINGLIST ((STRUCTURE ((CTENTRY 1 (N)
                                          6 2 2)
                                 (CTENTRY 2 (C)
                                          3 1 1)
                                 (CTENTRY 6 (N)
                                          1 5)
                                 (CTENTRY 5 (C)
                                          6 4)
                                 (CTENTRY 4 (C)
                                          5 3)
                                 (CTENTRY 3 (C)
                                          2 4))
                                (MBONDS . 3)
                                6
                                ((6 5 4 3)
                                 (1 2)))
          (STRUCTURE ((CTENTRY 1 (C)
                               6 2 2)
                      (CTENTRY 2 (N)
                               3 1 1)
                      (CTENTRY 6 (N)
                               1 5)
                      (CTENTRY 5 (C)
                               6 4)
                      (CTENTRY 4 (C)
                               5 3)
                      (CTENTRY 3 (C)
                               2 4))
                     (MBONDS . 3)
                     6
                     ((6 5 4 3)
                      (1 2)))
          (STRUCTURE ((CTENTRY 1 (N)
                               6 2 2)
                      (CTENTRY 2 (C)
                               3 1 1)
                      (CTENTRY 6 (C)
                               1 5)
                      (CTENTRY 5 (N)
                               6 4)
                      (CTENTRY 4 (C)
                               5 3)
                      (CTENTRY 3 (C)
                               2 4))
                     (MBONDS . 3)
                     6
                     ((6 5 4 3)
                      (1 2)))
          (STRUCTURE ((CTENTRY 1 (C)
                               6 2 2)
                      (CTENTRY 2 (N)
                               3 1 1)
                      (CTENTRY 6 (C)
                               1 5)
                      (CTENTRY 5 (N)
                               6 4)
                      (CTENTRY 4 (C)
                               5 3)
                      (CTENTRY 3 (C)
                               2 4))
                     (MBONDS . 3)
                     6
                     ((6 5 4 3)
                      (1 2]
  (RPAQQ DARINGSUB1 ((1 N (6 2 2)
                        0 0)
          (2 C (3 1 1)
             0 0)
          (6 N (1 5)
             0 0)
          (5 N (6 4)
             0 0)
          (4 C (5 3)
             0 0)
          (3 C (2 4)
             0 0)))
  (RPAQQ ETHER ((1 O NIL NIL 0 0 0)))
  [RPAQQ ETHERRING (STRUCTURE ((CTENTRY 1 (C)
                                        6 2 2)
                               (CTENTRY 2 (C)
                                        3 1 1)
                               (CTENTRY 6 (O)
                                        1 5)
                               (CTENTRY 5 (C)
                                        6 4)
                               (CTENTRY 4 (C)
                                        5 3)
                               (CTENTRY 3 (C)
                                        2 4))
                              (MBONDS . 3)
                              6
                              ((6 5 4 3)
                               (1 2]
  (RPAQQ KETONE ((1 C (2)
                    1 0 NIL 0)
          (2 O (1)
             1 0 NIL NIL)))
  (RPAQQ MAPPING NIL)
  (RPAQQ MATCHNUM 1)
  (RPAQQ OXIME ((1 C (2)
                   1 NIL NIL NIL)
          (2 N (1 3)
             1 NIL NIL NIL)
          (3 O (2)
             NIL NIL 0 NIL)))
  [RPAQQ RINGX (STRUCTURE ((CTENTRY 4 (C)
                                    1 3 FV FV)
                           (CTENTRY 3 (C)
                                    4 2 FV FV)
                           (CTENTRY 2 (N)
                                    3 1 FV)
                           (CTENTRY 1 (N)
                                    4 2 FV))
                          (SINGLERING . 4)
                          4
                          ((4 3 2 1))
                          ((3 4 1 2]
  [RPAQQ RINGY (STRUCTURE ((CTENTRY 4 (C)
                                    1 3 FV FV)
                           (CTENTRY 3 (N)
                                    4 2 FV)
                           (CTENTRY 2 (C)
                                    3 1 FV FV)
                           (CTENTRY 1 (N)
                                    4 2 FV))
                          (SINGLERING . 4)
                          4
                          ((4 3 2 1))
                          ((2 3 4 1))
                          ((4 1 2 3))
                          ((2 1 4 3]
  (RPAQQ STRUCTURE ((CTENTRY 6 (C (DOT . 0))
                             4 3 5 5)
          (CTENTRY 5 (C (DOT . 0))
                   2 1 6 6)
          (CTENTRY 4 (C (DOT . 0))
                   6 1 3 3)
          (CTENTRY 3 (C (DOT . 0))
                   6 4 4 2)
          (CTENTRY 2 (C (DOT . 0))
                   5 1 3 1)
          (CTENTRY 1 (C (DOT . 0))
                   5 4 2 2)))
  (RPAQQ SUBGRAPH ((1 N (2)
                      0 1 NIL NIL)
          (2 N (1)
             0 1 NIL NIL)))
  (RPAQQ TEST2 ((1 N (4 2)
                   0 1 NIL NIL)
          (2 N (1 3)
             0 1 NIL NIL)
          (3 C (4 2)
             0 2 NIL NIL)
          (4 C (1 3)
             0 2 NIL NIL)))
  (RPAQQ THIOETHER ((1 S NIL NIL 0 0 0)))
  (RPAQQ THIOL ((1 C (2)
                   NIL 0 NIL NIL)
          (2 S (1)
             NIL 1 NIL NIL)))
  (RPAQQ MATCHTESTLIST (VALDISTCHECK))
STOP